home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 September & October / rerun-1986-09-10.d64 / find the word (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  4KB  |  146 lines
  1. 2 goto10
  2. 5 dime$(20,22),d$(20),zx(20),zy(20),qa(8),qb(8),tw(20),h$(20,22):return
  3. 10 rem jerry caron
  4. 12 rem berkley st.
  5. 14 rem berkley,ma.
  6. 20 rem initialize
  7. 30 print"[147]   find a word"
  8. 40 print"are you using":print"a vic 20[146] or a 64[146]"
  9. 42 input"enter 20 or 64  64[157][157][157][157]";ma:ifma<>20and ma<>64then42
  10. 44 input"load a previous puzzle (y or n)";lp$
  11. 45 iflp$<>"y"andlp$<>"n"thenprint"[145][145][145][145]":goto44
  12. 46 iflp$="y"thengosub1000
  13. 55 ifma=20thenpoke36879,8
  14. 56 print:print
  15. 57 input" puzzle size (10-20)  20[157][157][157][157]";ms
  16. 58 ifms<10orms>20then57
  17. 59 gosub950
  18. 60 print"[147] setting up please wait..."
  19. 70 ifsw$<>"y"thengosub5
  20. 80 fori=1toms:forj=1toms:e$(i,j)="":next:next
  21. 90 restore:forj=1toop:fori=1to8 : readqa(i),qb(i):next:next
  22. 100 data.,-1,1,-1,1,.,1,1,.,1,-1,1,-1,.,-1,-1,.,1,1,-1,1,1,1,.,.,1,1,-1,1,1,1,.
  23. 103 data.,1,1,.,.,-1,-1,.,.,1,1,.,.,-1,-1,.,.,1,1,.,.,1,1,.,.,1,1,.,.,1,1,.
  24. 108 ifsw$="y"then310
  25. 110 fori=1toms:d$(i)="":zx(i)=0:zy(i)=0:next
  26. 200 rem input words
  27. 205 iflp$="y"then310
  28. 210 print"[147]how many words (max ";ms-op+1;")"
  29. 220 input nd$
  30. 230 print:nw=val(nd$):ifnw<1ornw>ms-op+1then210
  31. 240 print"[147] now type in the words"
  32. 250 print"each must be between 3 and ";int(.76*ms);" letters"
  33. 260 fori=1tonw
  34. 270 printi"[157]) ";
  35. 280 input"[157]";d$(i)
  36. 290 if len(d$(i))<3 or  len(d$(i))>int(.76*ms)thenprintchr$(13)"[145][145][145]":goto270
  37. 300 print:next
  38. 310 open4,4
  39. 315 print#4,spc(ms-5);chr$(14)+"find the words"+chr$(15):print#4:print#4
  40. 316 iflp$="y"thenprint#4,"puzzle name : ";np$:print#4
  41. 317 forr=1to3*ms+4:print#4,"*";:nextr:print#4:print#4
  42. 320 fori=1tonw
  43. 330 print#4,d$(i);spc(ms-len(d$(i)));:ifi=4ori=8ori=12ori=16thenprint#4,:
  44. 340 next
  45. 350 print#4,:print#4,:forr=1to3*ms+4 :print#4,"*";:nextr:print#4,:print#4,"*";
  46. 360 print#4," ";spc(3*ms+1);"*"
  47. 370 close4:iflp$="y"then700
  48. 380 ifep$="y"then700
  49. 400 rem place
  50. 410 print"[147]  making grid "
  51. 420 print"    please wait"
  52. 430 pw=0:forab=1tonw:pw=pw+1
  53. 440 zx(pw)=int(ms*rnd(1)+1)
  54. 450 zy(pw)=int(ms*rnd(1)+1)
  55. 460 dr=int(8*rnd(1)+1):tw(pw)=dr
  56. 470 cx=zx(pw)+len(d$(pw))*qa(dr):cy=zy(pw)+len(d$(pw))*qb(dr)
  57. 480 ifcx<1orcx>msorcy<1orcy>msthen440
  58. 490 f=0:forck=0tolen(d$(pw))-1
  59. 500 z1$=mid$(d$(pw),ck+1,1):z2$=e$(zx(pw)+ck*qa(dr),zy(pw)+ck*qb(dr))
  60. 510 ifz2$<>""andz1$<>z2$thenf=1
  61. 520 next:iff=1then440
  62. 530 forck=0tolen(  d$(pw))-1
  63. 540 z1$=mid$(d$(pw),ck+1,1):e$(zx(pw)+ck*qa(dr),zy(pw)+ck*qb(dr))=z1$
  64. 550 next
  65. 560 next ab
  66. 600 rem print search matrix
  67. 610 print"[147]"
  68. 620 print"":fory=1toms:forx=1toms
  69. 621 ifms<20anddx=1thenprint
  70. 622 h$(x,y)=e$(x,y):ife$(x,y)=""thenh$(x,y)="-"
  71. 625 ife$(x,y)=""thene$(x,y)=mid$(d$(nw*rnd(1)+1),3*rnd(1)+1,1)
  72. 640 ifma=64thenprinte$(x,y);" ";:goto660
  73. 650 ifma=20thenprinte$(x,y);
  74. 660 next
  75. 670 ifma=20thenprint
  76. 690 c=0:next
  77. 700 open4,4
  78. 710 fory=1toms:print#4,"*  ";:forx=1toms
  79. 720 print#4,e$(x,y);"  ";
  80. 730 next:print#4,"*":print#4,"*";spc(3*ms+2);"*":next
  81. 740 forr=1to3*ms+4:print#4,"*";:nextr:print#4,:print#4:close4
  82. 800 print"[147]":lp$="":gs$="":sp$="":s$="" :ep$="":sw$=""
  83. 805 input"want the answers  y or n  y[157][157][157]";gs$
  84. 807 ifgs$="y"thenprint" don't peek!":gosub900
  85. 808 print" save the puzzle (y or n)";
  86. 809 inputsp$:ifsp$="y"theninput" name of puzzle";np$:np$=np$+".ws":gosub1100
  87. 810 input"y[146]es to run again  y[157][157][157]";s$:ifs$<>"y"thenend
  88. 820 input"want exact same puzzle (y or n)";ep$:ifep$="y"then310
  89. 830 input"want the same words (y or n)";sw$:ifsw$="y" then1200
  90. 840 ifep$="n"thenclr:goto44
  91. 860 print"[147] program over":end
  92. 900 open4,4
  93. 903 fori=1to10-2*ms:print#4:next
  94. 910 fory=1toms :forx=1toms
  95. 911 print#4,h$(x,y);" ";
  96. 920 next:print#4:next
  97. 930 print#4:close4:return
  98. 940 rem  direction option menu
  99. 950 print"[147] word direction options [146]"
  100. 960 print"   1. every direction"
  101. 965 print"   2. no reversed words"
  102. 970 print"   3. no diagonal words"
  103. 975 print"   4. no diagonal or reversed words"
  104. 980 input"choose option[146] (1-4)  1[157][157][157]";op
  105. 982 ifop<1orop>4thenprint"[145][145][145]":goto980
  106. 985 return
  107. 1000 rem load routine*****************
  108. 1005 open15,8,15:print#15,"i0"
  109. 1010 print"name of puzzle";:inputnp$:np$=np$+".ws"
  110. 1020 open1,8,8,np$+",s,r"
  111. 1025 input#15,e,e$,e1,e2
  112. 1027 ifethenprint"program aborted *error* ";e$:close1:close15:end
  113. 1030 input#1,ms
  114. 1031 input#1,nw
  115. 1032 input#1,op
  116. 1035 gosub5
  117. 1040 fory=1toms:forx=1toms
  118. 1050 input#1,e$(x,y)
  119. 1060 next:next
  120. 1065 fori=1tonw:input#1,d$(i):next
  121. 1066 fory=1toms:forx=1toms
  122. 1067 input#1,h$(x,y)
  123. 1068 next:next
  124. 1070 close1:close15
  125. 1080 goto310
  126. 1100 rem save routine*****************
  127. 1101 print"saving puzzle"
  128. 1103 open15,8,15:print#15,"i0"
  129. 1110 open1,8,8,"0:"+np$+",s,w"
  130. 1115 input#15,e,e$,e1,e2:ifethenprint"prg. aborted *error* ";e$:close15:end
  131. 1120 print#1,ms
  132. 1121 print#1,nw
  133. 1125 print#1,op
  134. 1130 fory=1toms:forx=1toms
  135. 1140 print#1,e$(x,y)
  136. 1150 next:next
  137. 1155 fori=1tonw:print#1,d$(i):next
  138. 1158 fory=1toms:forx=1toms
  139. 1159 print#1,h$(x,y)
  140. 1160 next:next
  141. 1165 close1:close15
  142. 1170 return
  143. 1200 print"please wait":forx=1to20:fory=1to22:e$(x,y)="":h$(x,y)="":next:next
  144. 1210 forx=1to20:zx(x)=0:zy(x)=0:tw(x)=0:next:forx=1to8:qa(x)=0:qb(x)=0:next
  145. 1220 goto59
  146.